home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 726-750 / 729 / bbbbs / bbbbs54.lzh / rexx / bbsExtDL.baud < prev    next >
Text File  |  1992-07-22  |  12KB  |  429 lines
  1. /*      $VERS: 5.3 bbsExtDL.baud 22 Jul 1992 (22.7.92)
  2.     copyright 1992 Richard Lee Stockton FREELY DISTRIBUTABLE
  3.  
  4. Allows BBBBS user to download from extra devices like CD drives.
  5.  Keeps track of time left to this user, and watches for hangup.
  6.  
  7.    Just ignores file or directory names that contain spaces
  8.     because BBBBS would be unable to download them anyway.
  9.    Ignores icons (files that end in .info). Also excludes certain
  10.     drawers on certain CDs that contain copyright files. Other
  11.     specific files or directories can be excluded by adding
  12.     their paths to the exclude variable below.
  13. */
  14.  
  15. /* Xetec Fish and More Vols I and II */
  16. exclude='FISH_AND_MORE:C FISH_AND_MORE:SYSTEM FISH_AND_MOREII:C'
  17.  
  18. /* HyperMedia FredFish CD version 1.2 - limited to 3 drawers */
  19. exclude=exclude 'FFCD_V1.2:LZH_FILES/CATALOGS'
  20. exclude=exclude 'FFCD_V1.2:C FFCD_V1.2:DEVS'
  21. exclude=exclude 'FFCD_V1.2:L FFCD_V1.2:LIBS'
  22. exclude=exclude 'FFCD_V1.2:S FFCD_V1.2:FONTS'
  23. exclude=exclude 'FFCD_V1.2:T FFCD_V1.2:PREFS'
  24. exclude=exclude 'FFCD_V1.2:SYSTEM    FFCD_V1.2:SID'
  25. exclude=exclude 'FFCD_V1.2:AQUARIUM  FFCD_V1.2:UTILITIES'
  26. exclude=exclude 'FFCD_V1.2:CATALOGS  FFCD_V1.2:CDS.FILES'
  27. exclude=exclude 'FFCD_V1.2:EXPANSION FFCD_V1.2:READMEMASTER'
  28. exclude=exclude 'FFCD_V1.2:READ_ME   FFCD_V1.2:TRASHCAN'
  29. exclude=exclude 'FFCD_V1.2:SHELL'
  30. exclude=exclude 'FFCD_V1.2:CDTV.TM FFCD_V1.2:CD_SAMPLER'
  31.  
  32. /* HyperMedia FredFish Online CD version 1.4 - limited to 2 drawers */
  33. exclude=exclude 'FFONL_V1.4:LZH_FILES/CATALOGS'
  34. exclude=exclude 'FFONL_V1.4:C FFONL_V1.4:DEVS'
  35. exclude=exclude 'FFONL_V1.4:L FFONL_V1.4:LIBS'
  36. exclude=exclude 'FFONL_V1.4:S FFONL_V1.4:FONTS'
  37. exclude=exclude 'FFONL_V1.4:T FFONL_V1.4:PREFS'
  38. exclude=exclude 'FFONL_V1.4:SYSTEM    FFONL_V1.4:SID'
  39. exclude=exclude 'FFONL_V1.4:AQUARIUM  FFONL_V1.4:UTILITIES'
  40. exclude=exclude 'FFONL_V1.4:CATALOGS  FFONL_V1.4:CDS.FILES'
  41. exclude=exclude 'FFONL_V1.4:EXPANSION FFONL_V1.4:READMEMASTER'
  42. exclude=exclude 'FFONL_V1.4:READ_ME   FFONL_V1.4:TRASHCAN'
  43. exclude=exclude 'FFONL_V1.4:SHELL     FFONL_V1.4:TOOLS'
  44. exclude=exclude 'FFONL_V1.4:CDTV.TM   FFONL_V1.4:NODE.RINFO'
  45. exclude=exclude 'FFONL_V1.4:PARNET    FFONL_V1.4:START_PARNET'
  46. exclude=exclude 'FFONL_V1.4:COPYRITE.TXT'
  47.  
  48.  
  49. SIGNAL ON BREAK_C
  50. SIGNAL ON BREAK_E
  51.  
  52. PARSE ARG name level maxtime linesperpage colorflag devlist 
  53.  
  54. lists.=''
  55. lists.0=0
  56. maxtime=maxtime-30
  57. CALL TIME('R')
  58. CR='0D'x
  59. def=''
  60. pen3=''
  61. IF colorflag~=1 THEN
  62.   DO
  63.     def=''
  64.     pen3=''
  65.   END
  66.  
  67. SAY CR
  68. SAY 'This routine lets you select a list of files to be downloaded'CR
  69. SAY 'from one or more extra devices.  For example, CD-ROM drives.'CR
  70. SAY CR
  71. SAY 'Note that it is more efficient for all concerned if you use the'CR
  72. SAY 'various contents files available here (or Aquarium, in the case'CR
  73. SAY 'of Fish Disks), to make your selections before you call. Thanks!'CR
  74. SAY CR
  75.  
  76. selected=''
  77. path=''
  78. templist=devlist
  79. devlist=''
  80. longest=0
  81. CALL PRAGMA('W','N')  /* disk requesters OFF */
  82. DO i=1 TO WORDS(templist)
  83.   test=WORD(templist,i)
  84.   IF ~EXISTS(test) THEN ITERATE i
  85.   CALL PRAGMA('D',test)
  86.   test2=PRAGMA('D')
  87.   IF WORDS(test2)>1 THEN test2=test
  88.   devlist=STRIP(devlist test2)
  89.   IF LENGTH(test2)>longest THEN longest=LENGTH(test2)
  90. END
  91. cols=76%(longest+8)
  92. IF devlist='' THEN
  93.   DO
  94.     SAY CR
  95.     SAY '*** Sorry, no External Devices are available! ***'CR
  96.     SAY CR
  97.     EXIT('')
  98.   END
  99.  
  100. picklist=devlist
  101. IF WORDS(picklist)=1 THEN
  102.   DO
  103.     path=picklist
  104.     IF RIGHT(path,1)~=':' THEN path=path'/'
  105.     picklist=makepicklist()
  106.   END
  107. ELSE
  108.   DO
  109.     lists.0=1
  110.     dirs=WORDS(devlist)
  111.   END
  112. CALL checkdcd()
  113.  
  114. OPTIONS PROMPT 'Press RETURN'
  115. PULL junk
  116.  
  117. DO loop=1
  118.   CALL checkdcd()
  119.   test=TIME('E')
  120.   IF test>(maxtime-100) THEN
  121.     DO
  122.       SAY CR
  123.       IF test>maxtime THEN
  124.         DO
  125.           SAY '*** This session''s time is expiring! ***'CR
  126.           SAY CR
  127.           LEAVE loop
  128.         END
  129.       ELSE SAY '*** Less than 2 minutes remaining! ***'CR
  130.       SAY CR
  131.     END
  132.   filename=pick(picklist)
  133.   IF filename='' THEN
  134.     DO
  135.       temp=path
  136.       IF RIGHT(temp,1)='/' THEN temp=LEFT(temp,LENGTH(temp)-1)
  137.       IF FIND(UPPER(devlist),UPPER(temp))>0 THEN
  138.         DO
  139.           IF WORDS(devlist)=1 THEN ITERATE loop
  140.           picklist=devlist
  141.           path=''
  142.           ITERATE loop
  143.         END
  144.       ELSE
  145.         DO
  146.           test=RIGHT(path,1)
  147.           IF test='/' THEN path=LEFT(path,LENGTH(path)-1)
  148.           slash=LASTPOS('/',path)
  149.           IF slash=0 THEN slash=LASTPOS(':',path)
  150.           path=LEFT(path,slash)
  151.         END
  152.     END
  153.   IF WORD(STATEF(path||filename),1)='FILE' THEN
  154.     DO
  155.       IF FIND(UPPER(selected),UPPER(path||filename))=0 THEN
  156.         selected=selected path||filename
  157.       ELSE selected=DELWORD(selected,FIND(UPPER(selected),UPPER(path||filename)),1)
  158.       ITERATE loop
  159.     END
  160.   ELSE IF WORD(STATEF(path||filename),1)='DIR' THEN
  161.     DO
  162.       path=path||filename
  163.       test=RIGHT(path,1)
  164.       IF test~='' & test~='/' & test~=':' THEN path=path'/'
  165.     END
  166.   ELSE IF UPPER(filename)='DONE' THEN LEAVE loop
  167.   IF path~='' THEN picklist=makepicklist()
  168. END
  169. SAY 'Returning to the BBS...'CR
  170. SAY CR
  171. EXIT(STRIP(selected))
  172.  
  173.  
  174. checkdcd:
  175. IF ADDRESS()='BAUD' THEN
  176.   DO
  177.     dcd
  178.     IF RC=0 THEN
  179.       DO
  180.         CALL DELAY(128)
  181.         dcd
  182.         IF RC=0 THEN
  183.           DO
  184.             SAY CR
  185.             SAY '*** Lost Carrier!?! ***'CR
  186.             EXIT('')
  187.           END
  188.       END
  189.   END
  190. RETURN
  191.  
  192.  
  193. makepicklist:
  194. IF STORAGE()<100000 THEN
  195.   DO
  196.     lists.=''
  197.     lists.0=0
  198.     IF WORDS(devlist)>1 THEN
  199.       DO
  200.         lists.0=1
  201.         lists.1.0=devlist
  202.       END
  203.   END
  204. DO i=1 TO lists.0
  205.   IF path=lists.i THEN RETURN(lists.i.0)
  206. END
  207. IF path='' THEN RETURN('')
  208. SAY 'Loading...'CR
  209. CALL FileList(path'*',filelist,'F','N')
  210. IF filelist.0>1 THEN CALL QSORT(1,filelist.0,filelist)
  211. CALL FileList(path'*',dirlist,'D','N')
  212. IF dirlist.0>1 THEN CALL QSORT(1,dirlist.0,dirlist)
  213. plist=''
  214. dirs=0
  215. longest=0
  216. DO i=1 TO filelist.0
  217.   IF WORDS(filelist.i)~=1 THEN ITERATE i
  218.   IF filelist.i='' THEN ITERATE i
  219.   IF UPPER(RIGHT(filelist.i,5))='.INFO' THEN ITERATE i
  220.   IF FIND(exclude,UPPER(path||filelist.i))>0 THEN ITERATE i
  221.   plist=STRIP(plist filelist.i)
  222.   IF LENGTH(filelist.i)>longest THEN longest=LENGTH(filelist.i)
  223. END
  224. DO i=1 TO dirlist.0
  225.   IF WORDS(dirlist.i)~=1 THEN ITERATE i
  226.   IF UPPER(RIGHT(dirlist.i,5))='.INFO' THEN ITERATE i
  227.   IF FIND(exclude,UPPER(path||dirlist.i))>0 THEN ITERATE i
  228.   plist=STRIP(plist dirlist.i)
  229.   IF LENGTH(dirlist.i)>longest THEN longest=LENGTH(dirlist.i)
  230.   dirs=dirs+1
  231. END
  232. cols=76%(longest+9)
  233. lists.0=lists.0+1
  234. i=lists.0
  235. lists.i=path
  236. lists.i.0=plist
  237. DROP filelist. dirlist. 
  238. RETURN(plist)
  239.  
  240.  
  241. pick:
  242. PARSE ARG list 
  243. selection=''
  244. DO k=1 TO lists.0
  245.   IF path=lists.k THEN LEAVE k
  246. END
  247. IF ~DATATYPE(lists.k.ROWS,'N') THEN
  248.   DO
  249.     items=WORDS(list)
  250.     IF items<75 & dirs<15 THEN SAY 'Formatting' items 'items...'CR
  251.     ELSE SAY 'Please be patient, formatting' items 'items may take a while...'CR
  252.     lists.k.ROWS=(items%cols)+((items//cols)>0)
  253.     IF cols>items THEN cols=items
  254.     IF cols<1 THEN cols=1
  255.     longest=(76%cols)-8
  256.     lists.k=path
  257.     DO j=0 TO cols-1
  258.       DO i=1 TO lists.k.ROWS
  259.         thisnum=j*lists.k.ROWS+i
  260.         IF thisnum<=items THEN
  261.           DO
  262.             thisitem=WORD(list,thisnum)
  263.             filestat=STATEF(path||thisitem)
  264.             thisitem=LEFT(thisitem,longest)' '
  265.             IF WORD(filestat,1)='DIR' THEN
  266.               lists.k.i=lists.k.i||pen3'(dir) 'thisitem||def
  267.             ELSE
  268.               DO
  269.                 bytes=WORD(filestat,2)
  270.                 IF bytes<10000 THEN 
  271.                   lists.k.i=lists.k.i||RIGHT(bytes,5) thisitem
  272.                 ELSE IF bytes>1023999 THEN 
  273.                   lists.k.i=lists.k.i||RIGHT(bytes%1024000,4)'m' thisitem
  274.                 ELSE lists.k.i=lists.k.i||RIGHT(bytes%1024,4)'k' thisitem
  275.               END
  276.           END
  277.       END
  278.     END
  279.   END
  280. IF selected~='' THEN
  281.   DO
  282.     SAY CR
  283.     SAY pen3'selected:'def||CR
  284.     DO i=1 TO WORDS(selected)
  285.       SAY WORD(selected,i)||CR
  286.     END
  287.   END
  288. SAY CR
  289. SAY 'current path ='pen3 path||def||CR
  290. SAY LEFT('-',75,'-')||CR
  291. OPTIONS PROMPT ' - ['pen3'N'def']on-stop  ['pen3'Q'def']uit  ['pen3'RETURN'def']=Continue - '
  292. DO i=1 TO lists.k.ROWS
  293.   SAY TRIM(lists.k.i)||CR
  294.   IF (i+2)//(linesperpage-1)=0 & nonstop~=1 THEN
  295.     DO
  296.       CALL whodat()
  297.       PULL junk
  298.       IF LEFT(UPPER(junk),1)='Q' THEN LEAVE i
  299.       IF LEFT(UPPER(junk),1)='N' THEN nonstop=1
  300.       IF colorflag=1 THEN SAY '1B'x'M'||LEFT('',60)||'1B'x'M'||CR
  301.     END
  302. END
  303. nonstop=0
  304. SAY LEFT('-',75,'-')||CR
  305. CALL whodat()
  306. readflag=0
  307. DO getloop=1
  308.   pstring=showtime()'   Enter ''?'' for HELP > '
  309.   OPTIONS PROMPT pstring
  310.   PARSE PULL selection 
  311.   IF selection='?' THEN
  312.     DO
  313.       CALL help()
  314.       OPTIONS PROMPT 'Press RETURN'
  315.       PULL junk
  316.       selection=';-)'
  317.       LEAVE getloop
  318.     END
  319.   IF WORDS(selection)>1 & UPPER(WORD(selection,1))='READ' THEN
  320.     DO
  321.       readflag=1
  322.       selection=STRIP(DELWORD(selection,1,1))
  323.     END
  324.   i=FIND('DONE' UPPER(list),UPPER(selection))
  325.   IF i=0 THEN ITERATE getloop
  326.   IF selection='' & path='' THEN ITERATE getloop
  327.   ELSE IF i>1 THEN selection=WORD(list,i-1)
  328.   IF readflag=1 THEN
  329.     DO
  330.       endtest=UPPER(RIGHT(selection,4))
  331.       IF FIND('.ARC .DMS .LZH .LHA .ZIP .ZOO',endtest)>0 THEN
  332.         DO
  333.           CALL Contents.rexx(path||selection)
  334.           IF EXISTS('RAM:CONTENTS') THEN CALL showtext('RAM: CONTENTS')
  335.         END
  336.       ELSE CALL showtext(path selection)
  337.       readflag=0
  338.       selection=';-)'
  339.     END
  340.   LEAVE getloop
  341. END
  342. RETURN(selection)
  343.  
  344.  
  345. showtext:
  346. PARSE ARG tpath' 'textfile 
  347. test=RIGHT(tpath,1)
  348. IF test~='' & test~=':' & test~='/' THEN tpath=tpath'/'
  349. x=OPEN(f,STRIP(tpath||textfile),'R')
  350. IF x=0 THEN RETURN
  351. test=READCH(f,64)
  352. mask=XRANGE(,'06'x)||XRANGE('0E'x,'1A'x)||XRANGE('1C'x,'1F'x)
  353. IF VERIFY(test,mask,'M')>0 THEN
  354.   DO
  355.     CALL CLOSE(f)
  356.     testloc=VERIFY(test,mask,'M')
  357.     SAY '*** not an archive or a text file! ***'CR
  358.     SAY 'Character number' testloc 'is ASCII' C2D(SUBSTR(test,testloc,1))||CR
  359.     RETURN
  360.   END
  361. CALL SEEK(f,0,'B')
  362. OPTIONS PROMPT ' - ['pen3'N'def']on-stop  ['pen3'Q'def']uit  ['pen3'RETURN'def']=Continue - '
  363. SAY CR
  364. SAY '-' tpath||textfile '-'CR
  365. DO i=1 WHILE ~EOF(f)
  366.   SAY COMPRESS(READLN(f),CR||'0C'x)||CR
  367.   IF i//(linesperpage-1)=0 & nonstop~=1 THEN
  368.     DO
  369.       CALL whodat()
  370.       PULL junk
  371.       IF LEFT(UPPER(junk),1)='Q' THEN LEAVE i
  372.       IF LEFT(UPPER(junk),1)='N' THEN nonstop=1
  373.       IF colorflag=1 THEN SAY '1B'x'M'||LEFT('',60)||'1B'x'M'||CR
  374.     END
  375. END
  376. CALL CLOSE(f)
  377. IF i//(linesperpage-1)>1 THEN PULL junk
  378. nonstop=0
  379. RETURN
  380.  
  381.  
  382. whodat:
  383. IF ADDRESS()~='BAUD' THEN RETURN
  384. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  385. CALL checkdcd()
  386. RETURN
  387.  
  388.  
  389. help:
  390. SAY CR
  391. SAY CR
  392. SAY pen3'- HELP -'def
  393. SAY CR
  394. SAY 'You can navigate through directory levels using the following commands.'CR
  395. SAY 'Remember that the name must appear in the display before you can select it.'CR
  396. SAY CR
  397. SAY 'To select an item from the displayed list, enter its name as displayed.'CR
  398. SAY 'If the selected item is a' pen3'directory'def', its contents will be displayed.'CR
  399. SAY 'If the selected item is a file, it is added to the ''selected'' list.'CR
  400. SAY 'To remove a selected file from the list, enter its name again.'CR
  401. SAY CR
  402. SAY 'To display the parent directory, enter an ''empty'' RETURN'CR
  403. SAY 'To read a textfile or see the contents of an archive, enter READ filename.'CR
  404. SAY CR
  405. SAY 'Enter'pen3 'DONE' def'to return to the BBS (and download any selected files)'CR
  406. SAY CR
  407. RETURN
  408.  
  409.  
  410. showtime:
  411. mins=(maxtime-TIME('E'))%60
  412. secs=TRUNC((maxtime-TIME('E'))//60)
  413. IF secs<10 THEN secs='0'secs
  414. RETURN('Time Remaining: 'mins':'secs)
  415.  
  416.  
  417. BREAK_E:
  418. SAY pen3'*** CONTROL-E BREAK ***'def||CR
  419. i=999999
  420. RETURN
  421.  
  422.  
  423. BREAK_C:
  424. SAY CR
  425. EXIT('')
  426.  
  427.  
  428. /* bbsExtDL.baud */
  429.